home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / PROLOG / HUMBOLT / HUMBOLTS / _files / _humboltsr / SYS._c < prev    next >
Text File  |  1990-06-10  |  4KB  |  188 lines
  1. /***************************************************
  2. ****************************************************
  3. **                                                **
  4. **  HU-Prolog     Portable Interpreter System     **
  5. **                                                **
  6. **  Release 1.62   January  1990                  **
  7. **                                                **
  8. **  Authors:      C.Horn, M.Dziadzka, M.Horn      **
  9. **                                                **
  10. **  (C) 1989      Humboldt-University             **
  11. **                Department of Mathematics       **
  12. **                GDR 1086 Berlin, P.O.Box 1297   **
  13. **                                                **
  14. ****************************************************
  15. ***************************************************/
  16.  
  17. /* system(...), timer(...), cls(...), gotoxy(...), 
  18. ** bdos(...), peek(...), poke(...)
  19. */
  20.  
  21. #include "systems.h"
  22. #include "types.h"
  23. #include "atoms.h"
  24. #include "errors.h"
  25. #include "files.h"
  26.  
  27. /*
  28. EXPORT long TIMER();
  29. EXPORT boolean FileExist();
  30. EXPORT void DOCLS(),DOGOTOXY();
  31. EXPORT boolean call_system(char *);
  32. */
  33.  
  34. IMPORT void TESTATOM(),ARGERROR();
  35.  
  36. #if !CPM
  37. boolean call_system(char *command)
  38. { 
  39. #undef system  /* to avoid clash between macro definitions and clib */
  40.     int system();       /* from clib */
  41. #if UNIX 
  42.   return (system(command) !=127); 
  43. #endif
  44. #if RISCOS 
  45.   return (system(command) == 0); 
  46. #endif
  47. #if MS_DOS 
  48.   return (system(command)==0); 
  49. #endif
  50. #if VMS
  51.   return (system(command) !=0); 
  52. #endif
  53. }
  54. #endif
  55.  
  56. #if RISCOS
  57. IMPORT long  clock();  /* From CLIB */
  58. #endif
  59.  
  60. GLOBAL long TIMER(void)
  61. /* returns the current system timer normalized to 1/100 sec. */
  62. {
  63. #if UNIX || VMS
  64.  static struct 
  65.      { long usertime,systime,cusertime,csystime; } UTIME;
  66.   long T;
  67.   IMPORT long times(); /* from clib */
  68.   (void)times(&UTIME);   
  69. #endif
  70. #if XENIX286
  71.   return UTIME.usertime*2l;
  72. #endif
  73. #if UNIX && !XENIX286
  74.   T=UTIME.usertime*5l;
  75.   return T/3l; 
  76. #endif
  77.  
  78. #if RISCOS
  79.   return  clock();
  80. #endif
  81.  
  82. #if VMS
  83.   return  UTIME.usertime;
  84. #endif
  85.  
  86. #if MS_DOS 
  87.   static union {long far *ptr; struct {unsigned off,seg; }ibm; }trans;
  88.   long T;
  89.   trans.ibm.seg=0; trans.ibm.off=0x46c; 
  90.   T= *(trans.ptr);
  91.   T=T*55l;
  92.   return T/10l;
  93. #endif
  94.  
  95. #if BIC
  96.   long T;
  97.   T=(long)(*((int *)(0xfc0c)));
  98.   return T+T;
  99. #endif
  100. }
  101.  
  102. GLOBAL boolean FileExist(char *filename)
  103. {
  104. #if UNIX || MS_DOS || VMS 
  105.     extern int access(); /* from clib UNIX, MS_DOS ,VMS */   
  106.     return (access(filename,0)==0) ;
  107. #endif
  108. #if !(UNIX || MS_DOS || VMS)
  109.     int f;
  110.     if((f=open(filename,0))>=0) { close(f); return true; }
  111.     return false;
  112. #endif
  113. }
  114.  
  115.  
  116.  
  117. GLOBAL char *s_cls(void)
  118. { 
  119. #if P8000
  120.     static char ss[]="\033*\036";
  121.     return ss;
  122. #endif
  123. #if VMS || MS_DOS || XENIX286 || SUN3
  124.     static char ss[]="\033[2J\033[0;0H";
  125.     return ss;
  126. #endif
  127. #if CPM
  128.     static char ss[]="\014";
  129.     return ss;
  130. #endif
  131. }
  132.  
  133. GLOBAL char *s_gotoxy(int S, int Z)
  134. { 
  135. #if P8000 
  136.    static char ss[]= "\033=ZS";
  137.    ss[2]=Z+32;ss[3]=S+32;
  138.    return ss;
  139. #endif
  140. #if VMS || MS_DOS || XENIX286 || SUN3
  141.    static char ss[]="\033[YY;XXH";
  142.    ss[2]= (char)(Z / 10) + '0';
  143.    ss[3]= (char)(Z % 10) + '0';
  144.    ss[5]= (char)(S / 10) + '0';
  145.    ss[6]= (char)(S % 10) + '0';
  146.    return ss;
  147. #endif
  148. #if CPM 
  149.    static char ss[]= "\033ZS";
  150.    ss[1]=Z+128;ss[2]=S+128;
  151.    return ss;
  152. #endif
  153. }
  154.    
  155. #if  CPM || HACKY
  156.  
  157. extern TERM A0,A1,A2;
  158.  
  159. GLOBAL boolean DOPOKE(void)
  160. { TERM T;
  161.   char *addr;
  162.   if(name(A0)!=INTT) ARGERROR();
  163.   addr=(char *)ival(A0);
  164.   T=A1;
  165.   while(name(T)==CONS_2)
  166.     { *addr++= (char)(INTVALUE(arg1(T))&0xff); T=arg2(T); }
  167.   TESTATOM(NIL_0,T);
  168.   return true;
  169. }
  170.  
  171. GLOBAL boolean DOPEEK(void)
  172. { TERM T,TT;
  173.   int i;
  174.   char *addr;
  175.   addr=(char *)INTVALUE(A0);
  176.   i=INTVALUE(A1);
  177.   T=TT=mkatom(NIL_0);
  178.   while(i-- >0)
  179.   { name(TT)=CONS_2;
  180.     son(TT)=mk2sons(INTT,(TERM)(*addr++),NIL_0,nil_term);  
  181.     TT=br(son(TT)); 
  182.   }
  183.   return UNI(A2,T); 
  184. }
  185.  
  186. #endif
  187.  
  188.